Visual Basic Source Code

home *** CD-ROM | disk | FTP | other *** search

/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / dierol1a / dierolle.frm (.txt) < prev next >

Wrap

Visual Basic Form | 1999-10-08 | 26.3 KB | 836 lines

VERSION 5.00 Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX" Begin VB.Form Form1 BackColor = &H00C00000& BorderStyle = 1 'Fixed Single Caption = " Die Roller" ClientHeight = 4725 ClientLeft = 150 ClientTop = 435 ClientWidth = 6345 Icon = "DieRoller_Frm.frx":0000 LinkTopic = "Form1" MaxButton = 0 'False MinButton = 0 'False ScaleHeight = 4725 ScaleWidth = 6345 StartUpPosition = 2 'CenterScreen Begin MSComDlg.CommonDialog CommonDialog1 Left = 2775 Top = 2160 _ExtentX = 847 _ExtentY = 847 _Version = 393216 End Begin VB.CommandButton Command3 Appearance = 0 'Flat BackColor = &H00C0C0C0& Caption = "Roll" Height = 375 Index = 7 Left = 915 Style = 1 'Graphical TabIndex = 33 Top = 4320 Width = 495 End Begin VB.CommandButton Command3 Appearance = 0 'Flat BackColor = &H00C0C0C0& Caption = "Roll" Height = 375 Index = 6 Left = 915 Style = 1 'Graphical TabIndex = 32 Top = 3720 Width = 495 End Begin VB.CommandButton Command3 Appearance = 0 'Flat BackColor = &H00C0C0C0& Caption = "Roll" Height = 375 Index = 5 Left = 915 Style = 1 'Graphical TabIndex = 31 Top = 3120 Width = 495 End Begin VB.CommandButton Command3 Appearance = 0 'Flat BackColor = &H00C0C0C0& Caption = "Roll" Height = 375 Index = 4 Left = 915 Style = 1 'Graphical TabIndex = 30 Top = 2520 Width = 495 End Begin VB.CommandButton Command3 Appearance = 0 'Flat BackColor = &H00C0C0C0& Caption = "Roll" Height = 375 Index = 3 Left = 915 Style = 1 'Graphical TabIndex = 29 Top = 1920 Width = 495 End Begin VB.CommandButton Command3 Appearance = 0 'Flat BackColor = &H00C0C0C0& Caption = "Roll" Height = 375 Index = 2 Left = 915 Style = 1 'Graphical TabIndex = 28 Top = 1320 Width = 495 End Begin VB.CommandButton Command3 Appearance = 0 'Flat BackColor = &H00C0C0C0& Caption = "Roll" Height = 375 Index = 1 Left = 915 Style = 1 'Graphical TabIndex = 27 Top = 720 Width = 495 End Begin VB.CommandButton Command3 Appearance = 0 'Flat BackColor = &H00C0C0C0& Caption = "Roll" Height = 375 Index = 0 Left = 915 Style = 1 'Graphical TabIndex = 26 Top = 120 Width = 495 End Begin VB.CommandButton Command2 Appearance = 0 'Flat BackColor = &H00C0C0C0& Caption = "-" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 195 Index = 7 Left = 675 Style = 1 'Graphical TabIndex = 25 Top = 4515 Width = 195 End Begin VB.CommandButton Command1 Appearance = 0 'Flat BackColor = &H00C0C0C0& Caption = "+" Height = 195 Index = 7 Left = 675 Style = 1 'Graphical TabIndex = 24 Top = 4320 Width = 195 End Begin VB.CommandButton Command2 Appearance = 0 'Flat BackColor = &H00C0C0C0& Caption = "-" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 195 Index = 6 Left = 675 Style = 1 'Graphical TabIndex = 23 Top = 3915 Width = 195 End Begin VB.CommandButton Command1 Appearance = 0 'Flat BackColor = &H00C0C0C0& Caption = "+" Height = 195 Index = 6 Left = 675 Style = 1 'Graphical TabIndex = 22 Top = 3720 Width = 195 End Begin VB.CommandButton Command2 Appearance = 0 'Flat BackColor = &H00C0C0C0& Caption = "-" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 195 Index = 5 Left = 675 Style = 1 'Graphical TabIndex = 21 Top = 3315 Width = 195 End Begin VB.CommandButton Command1 Appearance = 0 'Flat BackColor = &H00C0C0C0& Caption = "+" Height = 195 Index = 5 Left = 675 Style = 1 'Graphical TabIndex = 20 Top = 3120 Width = 195 End Begin VB.CommandButton Command2 Appearance = 0 'Flat BackColor = &H00C0C0C0& Caption = "-" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 195 Index = 4 Left = 675 Style = 1 'Graphical TabIndex = 19 Top = 2715 Width = 195 End Begin VB.CommandButton Command1 Appearance = 0 'Flat BackColor = &H00C0C0C0& Caption = "+" Height = 195 Index = 4 Left = 675 Style = 1 'Graphical TabIndex = 18 Top = 2520 Width = 195 End Begin VB.CommandButton Command2 Appearance = 0 'Flat BackColor = &H00C0C0C0& Caption = "-" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 195 Index = 3 Left = 675 Style = 1 'Graphical TabIndex = 17 Top = 2115 Width = 195 End Begin VB.CommandButton Command1 Appearance = 0 'Flat BackColor = &H00C0C0C0& Caption = "+" Height = 195 Index = 3 Left = 675 Style = 1 'Graphical TabIndex = 16 Top = 1920 Width = 195 End Begin VB.CommandButton Command2 Appearance = 0 'Flat BackColor = &H00C0C0C0& Caption = "-" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 195 Index = 2 Left = 675 Style = 1 'Graphical TabIndex = 15 Top = 1515 Width = 195 End Begin VB.CommandButton Command1 Appearance = 0 'Flat BackColor = &H00C0C0C0& Caption = "+" Height = 195 Index = 2 Left = 675 Style = 1 'Graphical TabIndex = 14 Top = 1320 Width = 195 End Begin VB.CommandButton Command2 Appearance = 0 'Flat BackColor = &H00C0C0C0& Caption = "-" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 195 Index = 1 Left = 675 Style = 1 'Graphical TabIndex = 13 Top = 915 Width = 195 End Begin VB.CommandButton Command1 Appearance = 0 'Flat BackColor = &H00C0C0C0& Caption = "+" Height = 195 Index = 1 Left = 675 Style = 1 'Graphical TabIndex = 12 Top = 720 Width = 195 End Begin VB.CommandButton Command2 Appearance = 0 'Flat BackColor = &H00C0C0C0& Caption = "-" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 195 Index = 0 Left = 675 Style = 1 'Graphical TabIndex = 11 Top = 315 Width = 195 End Begin VB.CommandButton Command1 Appearance = 0 'Flat BackColor = &H00C0C0C0& Caption = "+" Height = 195 Index = 0 Left = 675 Style = 1 'Graphical TabIndex = 10 Top = 120 Width = 195 End Begin VB.TextBox Txt_Result Appearance = 0 'Flat BorderStyle = 0 'None BeginProperty Font Name = "MS Sans Serif" Size = 12 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 4545 Left = 1470 Locked = -1 'True MultiLine = -1 'True ScrollBars = 2 'Vertical TabIndex = 9 Top = 120 Width = 4815 End Begin VB.Label Label1 Alignment = 1 'Right Justify BackColor = &H00C00000& Caption = "0" ForeColor = &H00FFFFFF& Height = 195 Index = 0 Left = 285 TabIndex = 0 Top = 195 Width = 150 End Begin VB.Label Label1 Alignment = 1 'Right Justify BackColor = &H00C00000& Caption = "0" ForeColor = &H00FFFFFF& Height = 195 Index = 7 Left = 90 TabIndex = 40 Top = 4395 Width = 150 End Begin VB.Label Label1 Alignment = 1 'Right Justify BackColor = &H00C00000& Caption = "0" ForeColor = &H00FFFFFF& Height = 195 Index = 6 Left = 195 TabIndex = 39 Top = 3795 Width = 150 End Begin VB.Label Label1 Alignment = 1 'Right Justify BackColor = &H00C00000& Caption = "0" ForeColor = &H00FFFFFF& Height = 195 Index = 5 Left = 195 TabIndex = 38 Top = 3195 Width = 150 End Begin VB.Label Label1 Alignment = 1 'Right Justify BackColor = &H00C00000& Caption = "0" ForeColor = &H00FFFFFF& Height = 195 Index = 4 Left = 195 TabIndex = 37 Top = 2595 Width = 150 End Begin VB.Label Label1 Alignment = 1 'Right Justify BackColor = &H00C00000& Caption = "0" ForeColor = &H00FFFFFF& Height = 195 Index = 3 Left = 195 TabIndex = 36 Top = 1995 Width = 150 End Begin VB.Label Label1 Alignment = 1 'Right Justify BackColor = &H00C00000& Caption = "0" ForeColor = &H00FFFFFF& Height = 195 Index = 2 Left = 285 TabIndex = 35 Top = 1410 Width = 150 End Begin VB.Label Label1 Alignment = 1 'Right Justify BackColor = &H00C00000& Caption = "0" ForeColor = &H00FFFFFF& Height = 195 Index = 1 Left = 285 TabIndex = 34 Top = 795 Width = 150 End Begin VB.Label Label2 Alignment = 1 'Right Justify BackColor = &H00C00000& Caption = "d12" ForeColor = &H00FFFFFF& Height = 195 Index = 4 Left = 270 TabIndex = 5 Top = 2595 Width = 360 End Begin VB.Label Label2 Alignment = 1 'Right Justify BackColor = &H00C00000& Caption = "d20" ForeColor = &H00FFFFFF& Height = 195 Index = 5 Left = 270 TabIndex = 8 Top = 3195 Width = 360 End Begin VB.Label Label2 Alignment = 1 'Right Justify BackColor = &H00C00000& Caption = "d30" ForeColor = &H00FFFFFF& Height = 195 Index = 6 Left = 270 TabIndex = 7 Top = 3795 Width = 360 End Begin VB.Label Label2 Alignment = 1 'Right Justify BackColor = &H00C00000& Caption = "d100" ForeColor = &H00FFFFFF& Height = 195 Index = 7 Left = 270 TabIndex = 6 Top = 4395 Width = 360 End Begin VB.Label Label2 Alignment = 1 'Right Justify BackColor = &H00C00000& Caption = "d10" ForeColor = &H00FFFFFF& Height = 195 Index = 3 Left = 270 TabIndex = 4 Top = 1995 Width = 360 End Begin VB.Label Label2 Alignment = 1 'Right Justify BackColor = &H00C00000& Caption = "d8" ForeColor = &H00FFFFFF& Height = 195 Index = 2 Left = 270 TabIndex = 3 Top = 1410 Width = 360 End Begin VB.Label Label2 Alignment = 1 'Right Justify BackColor = &H00C00000& Caption = "d4" ForeColor = &H00FFFFFF& Height = 195 Index = 0 Left = 435 TabIndex = 1 Top = 195 Width = 195 End Begin VB.Label Label2 Alignment = 1 'Right Justify BackColor = &H00C00000& Caption = "d6" ForeColor = &H00FFFFFF& Height = 195 Index = 1 Left = 270 TabIndex = 2 Top = 795 Width = 360 End Begin VB.Menu File Caption = "File" Begin VB.Menu Save Caption = "&Save" Shortcut = ^S End Begin VB.Menu Exit Caption = "E&xit" End End Begin VB.Menu Tools Caption = "Tools" Begin VB.Menu DieRoller Caption = "Get Die Totals" Checked = -1 'True End Begin VB.Menu DieStats Caption = "Get Die Stats" End End Begin VB.Menu NoofRolls Caption = "Number of Rolls" Begin VB.Menu NoRolls Caption = "10" Checked = -1 'True Index = 0 End Begin VB.Menu NoRolls Caption = "20" Index = 1 End Begin VB.Menu NoRolls Caption = "30" Index = 2 End Begin VB.Menu NoRolls Caption = "40" Index = 3 End Begin VB.Menu NoRolls Caption = "50" Index = 4 End Begin VB.Menu NoRolls Caption = "60" Index = 5 End Begin VB.Menu NoRolls Caption = "70" Index = 6 End Begin VB.Menu NoRolls Caption = "80" Index = 7 End Begin VB.Menu NoRolls Caption = "90" Index = 8 End Begin VB.Menu NoRolls Caption = "100" Index = 9 End Begin VB.Menu NoRolls Caption = "500" Index = 10 End End Begin VB.Menu Help Caption = "Help" Begin VB.Menu About Caption = "&About" End End Attribute VB_Name = "Form1" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Dim DefaultDir As String, FileNames As String Public Function FileRepExists(FileNames As String) As Boolean Dim val As Integer On Error Resume Next val = GetAttr(FileNames) FileRepExists = IIf(Err = 0, True, False) End Function Public Function GetRandomInteger(LowerBound, UpperBound) As Long 'Generate Random seed based upon time & Date Randomize Int(CDbl((Now))) + Timer GetRandomInteger = Int((UpperBound - LowerBound + 1) * Rnd + LowerBound) End Function Private Sub About_Click() Load frmAbout End Sub Private Sub Command1_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single) If val(Label1(Index)) <> 10 Then Label1(Index).Caption = val(Label1(Index)) + 1 End If End Sub Private Sub Command2_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single) If val(Label1(Index)) <> 0 Then Label1(Index).Caption = val(Label1(Index)) - 1 End If End Sub Private Sub Command3_Click(Index As Integer) Dim Var As Integer, Total As Integer, NoRolless As String, NoRolles As Integer, Num As Integer, N As Integer, O As Integer, RI As Integer, Roll(4000), Rolls As String, Per As Double, Perc As String If Label1(Index).Caption = 0 Then Exit Sub Select Case Index Case Is = 0 Var = 4 Case Is = 1 Var = 6 Case Is = 2 Var = 8 Case Is = 3 Var = 10 Case Is = 4 Var = 12 Case Is = 5 Var = 20 Case Is = 6 Var = 30 Case Is = 7 Var = 100 End Select Txt_Result.Text = "" If DieRoller.Checked = True Then For Num = 0 To 10 Select Case NoRolls(Num).Checked Case Is = True For N = 1 To val(NoRolls(Num).Caption) If N < 10 Then Txt_Result.Text = Txt_Result.Text & " " If N < 100 Then Txt_Result.Text = Txt_Result.Text & " " Txt_Result.Text = Txt_Result.Text & N & ": " Total = GetRandomInteger((Label1(Index).Caption), (Label1(Index).Caption) * Var) & vbNewLine Rolls = Total If Total < 10 Then Txt_Result.Text = Txt_Result.Text + " " If Total < 100 Then Txt_Result.Text = Txt_Result.Text + " " Txt_Result.Text = Txt_Result.Text + Rolls Txt_Result.Text = Txt_Result.Text + vbNewLine Next N End Select Next Num End If If DieStats.Checked = True Then For N = 1 To 1000 Total = 0 For O = 1 To (val(Label1(Index).Caption)) RI = GetRandomInteger(1, Var) Total = Total + RI Next O Roll(Total) = (val(Roll(Total))) + 1 Next N Txt_Result.Text = "I rolled " + Label1(Index).Caption + Label2(Index).Caption + " 1000 times and got the following results:" + vbNewLine Txt_Result.Text = Txt_Result.Text + "Number" + vbTab + "# Rolls" + vbTab + "Percent" + vbNewLine For RI = ((Label1(Index).Caption) * 1) To ((Label1(Index).Caption) * Var) Rolls = RI Txt_Result.Text = Txt_Result.Text + " " If RI < 10 Then Txt_Result.Text = Txt_Result.Text + " " Txt_Result.Text = Txt_Result.Text + Rolls Txt_Result.Text = Txt_Result.Text + " " Txt_Result.Text = Txt_Result.Text + vbTab + " " If Roll(RI) < 10 Then Txt_Result.Text = Txt_Result.Text + " " If Roll(RI) < 100 Then Txt_Result.Text = Txt_Result.Text + " " Rolls = Roll(RI) Per = ((Roll(RI)) / 1000) * 100 Perc = Per Txt_Result.Text = Txt_Result.Text + Rolls + " " Txt_Result.Text = Txt_Result.Text + vbTab + " " If Per < 10 Then Txt_Result.Text = Txt_Result.Text + " " Txt_Result.Text = Txt_Result.Text + Perc + "%" + vbNewLine Next RI End If End Sub Private Sub DieRoller_Click() DieRoller.Checked = True DieStats.Checked = False NoofRolls.Enabled = True End Sub Private Sub DieStats_Click() DieStats.Checked = True DieRoller.Checked = False NoofRolls.Enabled = False End Sub Private Sub Exit_Click() Unload Me End Sub Private Sub Form_Load() Dim Tittle As String, VerNum As String, Major As String, Minor As String, Revision As String Major = App.Major Minor = App.Minor Revision = App.Revision VerNum = Major + "." + Minor + Revision Tittle = App.Title + " " Form1.Caption = Tittle + VerNum DefaultDir = App.Path + "\" End Sub Private Sub Form_Unload(Cancel As Integer) End Sub Private Sub NoRolls_Click(Index As Integer) Dim Num For Num = 0 To 10 NoRolls(Num).Checked = False Next Num NoRolls(Index).Checked = True End Sub Private Sub Save_Click() Dim msg As String, Style As String, Title As String, Response, MyString As String On Error GoTo ErrorTrap: With CommonDialog1 .DefaultExt = "txt" .DialogTitle = "Save Results As" .Filter = "*.txt" .FileName = "" .ShowSave .InitDir = DefaultDir End With FileRepExists (FileNames) Select Case FileRepExists(FileNames) Case Is = True msg = FileNames + " already exists. Do you wish to replace it?" ' Define message. Style = vbYesNo + vbExclamation + vbDefaultButton2 ' Define buttons. Title = "Save As..." ' Define title. ' Display message. Response = MsgBox(msg, Style, Title) Select Case Response Case Is = vbNo ' User chose Yes. Exit Sub End Select End Select Open (CommonDialog1.FileName) For Output As #1 Print #1, Txt_Result.Text Close #1 ErrorTrap: If Err.Number = 32755 Then Exit Sub End If End Sub